perm filename MEM[G,BGB]5 blob
sn#072998 filedate 1974-01-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
C REC PAGE DESCRIPTION
C00001 00001 VALID 00008 PAGES
C00002 00002 TITLE MEM MEMORY MANAGEMENT ROUTINES.
C00005 00003 SUBR(MKCAMERA,WORLD)
C00007 00004 SUBR(MKWINDOW,CAMERA,WINDOW) MAKE AND LINK A WINDOW NODE.
C00009 00005 FAIL MORE CORE.
C00011 00006 SAIL MORE CORE.
C00013 00007 SUBRS MKNODE,KLNODE MAKE AND KILL NODES.
C00015 00008 SUBR COMPACT
C00020 00009 SUBR RELOCATE,OFFSET
C00022 ENDMK
C⊗;
TITLE MEM ;MEMORY MANAGEMENT ROUTINES.
INTERN OLD44,UNIVER,BLKCNT,AVAIL,INVALID
EXTERN REL ;RELOCATION BIT TABLE.
OLD44: 0 ;ORIGINAL JOBREL 44 CONTENTS.
UNIVER: 0 ;POINTER TO UNIVERSE NODE.
BLKCNT: 0 ;NUMBER OF NON EMPTY NODES.
AVAIL: 0 ;POINTER TO FIRST EMPTY NODE.
REMAINDER:0 ;NUMBER OF UNUSED WORDS BETWEEN
; THE TOP OF NODE SPACE AND THE TOP OF CORE.
INVALID:0 ;SET DURING SHRINK
NODSIZ←←=12 ;NUMBER OF WORDS PER NODE.
MINLINK←←-3 ;LOWEST NUMBERED LINK
TYPMASK←←17 ;MASK TO EXTRACT TYPE INFORMATION
SUBR(MKUNIV) ;MAKE UNIVERSE.
COMMENT ⊗------------------------------------------------------------
⊗
SETQ(WORLD,{MKWORLD}) ;MAKE A WORLD FOR THIS UNIVERSE.
SETQ(CAMERA,{MKCAMERA,WORLD}) ;MAKE A CAMERA FOR THIS WORLD.
SETQ(SUN,{MKCAMERA,[0]}) ;MAKE A SUN (LIKE A CAMERA).
LACI $SUN↔DAP(1) ;MARK THE NODE AS SUN TYPE.
FRAME 2,1↔LAC[100.0]↔DAC ZWC(1) ;PLACE SUN A HUNDRED FEET UP.
LAC 2,WORLD↔ALT. 1,2 ;PLACE THE SUN IN THE WORLD.
CALL(MKWINDOW,CAMERA,[0]) ;MAKE A WINDOW FOR THIS CAMERA.
POP0J
DECLARE{WORLD,CAMERA,SUN}
ENDR MKUNIV;7/12/73(BGB)---------------------------------------------
SUBR(MKWORLD) ;MAKE A WORLD NODE.
COMMENT ⊗------------------------------------------------------------
⊗
SETQ(WORLD#,{MKNODE,[PBIT+$WORLD]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
BRO. 1,1↔SIS. 1,1 ;WORLD RING.
CALL(MKFRAME↑) ;WORLD FRAME OF REFERENCE.
LAC 2,WORLD
FRAME. 1,2
;PLACE NEW WORLD AT THE END OF THE WORLD RING.
LAC 1,WORLD
LAC 4,UNIVERSE↔PWRLD 2,4 ;GET FIRST WORLD OF THIS UNIVERSE.
JUMPN 2,.+4
NWRLD. 1,4↔PWRLD. 1,4 ;INIT THE UNIVERSE'S WORLD RING.
POP0J
BRO 3,2
BRO. 1,2↔SIS. 2,1 ;RING-IN THE NEW WORLD.
SIS. 1,3↔BRO. 3,1
POP0J
ENDR MKWORLD;3/12/73(BGB)--------------------------------------------
SUBR(MKCAMERA,WORLD)
COMMENT ⊗------------------------------------------------------------
If WORLD argument is not zero then place camera in world's camera ring.
⊗
SETQ(CAMERA#,{MKNODE,[PBIT+$CAMERA]})
BRO. 1,1↔SIS. 1,1 ;CAMERA RING.
SKIPE 2,WORLD↔PWRLD. 2,1 ;CAMERA POINTS AT ITS WORLD.
;DEFAULT PHYSICAL RASTER SIZE.
DEFINE MM{3.280833E-3}
DEFINE MICRON{3.280833E-6}
LAC[38.78]↔FMPR[MICRON]↔DAC 1(1) ;PDX.
LAC[40.00]↔FMPR[MICRON]↔DAC 2(1) ;PDY.
LAC[12.50]↔FMPR[MM]↔ DAC 3(1) ;FOCAL
LACN 3(1)↔FDVR 1(1)↔DAC -3(1) ;SCALEX ← -FOCAL/PDX
LACN 3(1)↔FDVR 2(1)↔DAC -2(1) ;SCALEY ← -FOCAL/PDY
LACN 3(1)↔FDVR 2(1)↔DAC -1(1) ;SCALEZ ← -FOCAL/PDZ
;CAMERA LOCUS AND ORIENTATION.
CALL(MKFRAME↑)
LAC[16.0]↔DAC ZWC(1) ;16 FEET ABOVE XY PLANE.
LAC 2,CAMERA↔FRAME. 1,2
;PLACE NEW CAMERA AT THE END OF THE WORLD'S CAMERA RING.
LAC 1,CAMERA
LAC 4,WORLD↔PCAMR 2,4 ;GET FIRST CAMERA OF THIS WORLD.
JUMPN 2,.+4
NCAMR. 1,4↔PCAMR. 1,4 ;INIT THE WORLD'S CAMERA RING.
POP1J
BRO 3,2
BRO. 1,2↔SIS. 2,1 ;RING-IN THE NEW CAMERA.
SIS. 1,3↔BRO. 3,1↔POP1J
ENDR MKCAMERA;3/12/73(BGB)-------------------------------------------
SUBR(MKWINDOW,CAMERA,WINDOW) ;MAKE AND LINK A WINDOW NODE.
COMMENT ⊗------------------------------------------------------------
CAMERA argument may be zero.
Zero WINDOW argument will cause a new Display ring;
Otherwise new window placed into the display ring of the given window.
⊗
CALL(MKNODE,[PBIT+$WINDOW])
LAC[3.5]↔DAC -1(1) ;MAG
LAC[XWD -=511,=511]↔DAC 1(1) ;XWD XL,,XH
LAC[XWD -=384,=384]↔DAC 2(1) ;XWD YL,,YH
LAC CAMERA↔NCAMR. 0,1 ;POINTER TO CAMERA.
BRO. 1,1↔SIS. 1,1 ;WINDOW RING.
CW. 1,1↔CCW. 1,1 ;DISPLAY RING.
;PLACE NEW WINDOW IN DISPLAY RING NEXT TO GIVEN WINDOW.
SKIPN 2,WINDOW↔GO L1
SIS 3,2
SIS. 1,2↔BRO. 2,1
BRO. 1,3↔SIS. 3,1↔POP2J
;PLACE NEW WINDOW IN BRAND NEW DISPLAY RING, ALL BY ITSELF.
L1:
LAC 4,UNIVERSE↔CCW 2,4 ;GET FIRST DISPLAY RING.
CW. 1,4↔CCW. 1,4 ;UPDATE UNIVERSE NODE.
JUMPE 2,POP2J. ;EXIT WHEN FIRST DISPLAY RING.
CCW 3,2
CCW. 1,2↔CW. 2,1 ;RING-IN A NEW DISPLAY RING.
CW. 1,3↔CCW. 3,1
POP2J
ENDR MKWINDOW;3/12/73(BGB)-------------------------------------------
;FAIL MORE CORE.
IFE SAIL{
SUBR(MORCOR) ;Get more core *
COMMENT ⊗------------------------------------------------------------
⊗
;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
SKIPE OLD44↔GO L1 ;SKIP ON FIRST TIME ONLY.
LAC 1,44↔DAC 1,OLD44 ;SAVE JOBREL.
ADDI 1,1↔ ;SETUP UNIVERSE NODE.
ADDI 1,1↔DAC 1,AVAIL
ADDI 1,1↔DAC 1,BLKCNT
ADDI 1,1↔DAC 1,UNIVERSE
SETZM REMAINDER
;FOUR MORE K.
L1: LAC 1,44↔LAC 0,1↔ADDI 0,10000
CORE↔FATAL<NO MORE CORE.>
AOS 1↔SUB 1,REMAINDER
DAC 2,AC2#↔LAC 2,44
DZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
LACI 2↔DAP @UNIVERSE ;UNIVERSE NODE IS TYPE #2.
;MAKE AVAIL LIST.
DIP 1,1↔ADD 1,[XWD NODSIZ,0]
SKIPN@BLKCNT↔GO[
ADD 1,[XWD NODSIZ,NODSIZ]
AOS@BLKCNT↔GO .+1]
DAPZ 1,@AVAIL
L2: HLRZM 1,(1)↔AOS 3(1) ;EMPTY LINK & EMPTY NODE TYPE #1.
ADD 1,[XWD NODSIZ,NODSIZ]
CAILE 2,NODSIZ+NODSIZ-1(1)
GO L2↔AOS 3(1)
SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
LACI 10000↔LAC 1,UNIVER↔ADDM -3(1) ;CORE SIZE.
LAC 1,@AVAIL
LAC 2,AC2↔POP0J
ENDR MORCOR;4-DEC-72(BGB)
}
;SAIL MORE CORE.
IFN SAIL{
SUBR(MORCOR)------------------------------------------------------
ACCUMULATORS{PTR,SIZ}
; - GET MORE CORE FROM SAIL - BGB - 8 MARCH 1972.
PUSH P,PTR↔PUSH P,SIZ
SETZ PTR,
L1: LACI SIZ,NODSIZ*=400+1 ;AC3 SIZE OF SPACE.
CALL(CORGET↑) ;AC2 ADDRESS OF SPACE.
GO[FATAL(NO MORE CORE.)]↔SOS SIZ
SLACI(PTR)↔LAPI 1(PTR)↔DZM(PTR) ;CLEAR 4K BLOCK OF MEMORY.
BLT NODSIZ*=400-1(PTR) ;CLEAR 4K BLOCK OF MEMORY.
LAC 1,PTR ;-3 WORD OF FIRST NODE.
;INITIALIZE THE UNIVERSE WHEN NECESSARY.
SKIPE UNIVER↔GO L3
ADDI 1,1↔DAC 1,AVAIL ;POINTER TO AVAIL LIST.
ADDI 1,1↔DAC 1,BLKCNT ;POINTER TO NODE COUNT.
ADDI 1,1↔DAC 1,UNIVERSE ;POINTER TO UNIVERSE NODE.
LACI 2↔DAP@UNIVERSE ;UNIVERSE NODE IS TYPE #2.
;MAKE AVAIL LIST.
L3: DIP 1,1↔ADD 1,[XWD NODSIZ,0] ;XWD NEXT,,THIS
SKIPN@BLKCNT↔GO[
ADD 1,[XWD NODSIZ,NODSIZ] ;STEP OVER UNIVERSE.
AOS@BLKCNT↔SUBI SIZ,NODSIZ↔GO .+1]
SUBI SIZ,NODSIZ
DAPZ 1,@AVAIL
;PLACE EACH NEW EMPTY BLOCK ON THE AVAIL LIST.
L2: HLRZM 1,(1)↔AOS 3(1) ;EMPTY LIST POINTER & TYPE #1.
ADD 1,[XWD NODSIZ,NODSIZ]
SUBI SIZ,NODSIZ
JUMPG SIZ,L2↔AOS 3(1)
LAC 1,@AVAIL
POP P,3↔POP P,2↔POP0J
ENDR MORCOR;------------------------------------------------------
}
;SUBRS MKNODE,KLNODE ;MAKE AND KILL NODES.
;--------------------------------------------------------------------
SUBR(MKNODE,NODTYP) ;ALLOCATE A BLOCK OF NODSIZ WORDS.
SKIPN 1,@AVAIL↔CALL(MORCOR) ;GET AN EMPTY NODE.
CDR(1)↔DAP @AVAIL
DZM(1)↔AOS @BLKCNT↔ADDI 1,3
LAC NODTYP↔DAC(1) ;PLACE NODE TYPE INTO NODE.
POP1J
ENDR MKNODE;12/4/72(BGB)---------------------------------------------
SUBR(KLNODE,NODE) ;RELEASE BLOCK OF NODSIZ WORDS.
LAC 1,NODE↔LAC (1)
CAIN 0,1↔GO[FATAL(KILLING EMPTY NODE.)]
SOS @BLKCNT
LIPI -3(1)↔LAPI -2(1) ;CLEAR NODE.
SETZM -3(1)↔BLT 8(1)
AOS(1) ;MARK NODE TYPE EMPTY-1.
SUBI 1,3↔LAC@AVAIL ;CONS NODE TO AVAIL LIST.
DAPZ(1)↔DAPZ 1,@AVAIL
POP1J
ENDR KLNODE;12/4/72(BGB)---------------------------------------------
SUBR COMPACT
COMMENT ⊗------------------------------------------------------------
Note: to change to handle non-contiguous blocks of node space,
rewrite the following macro to know about block boundaries. ⊗
DEFINE NXTNOD(AC,LIMIT)
<ADDI AC,NODSIZ↔CAML AC,LIMIT>
ACCUMULATORS{P1,NODE,HOLE,ONE}
;Pass 1: Locate free nodes below BREAK and LAC nodes in use above
;break into free nodes, leaving pointer in its place to new node
;location.
LAC NODE,@BLKCNT ;CALCULATE ADDRESS OF BREAK
IMULI NODE,NODSIZ
ADD NODE,UNIVERSE
DAC NODE,BREAK
SUBI NODE,NODSIZ ;INCREMENTED AT HLOOP
MOVEI ONE,$EMPTY ;FOR A FAST TYPE CHECK
SKIPA HOLE,UNIVERSE
;HOLES LOOP.
HLOOP: NXTNOD HOLE,BREAK ;FIND A HOLE BELOW BREAK
GO UPDATE ;BREAK FOUND, NOW UP POINTS
CAME ONE,(HOLE) ;IS IT AN EMPTY NODE?
GO HLOOP
;NODES LOOP.
NLOOP: NXTNOD NODE,44 ;FIND A NODE ABOVE BREAK
GO [ WARNING<NODE COUNT TOO BIG> ;HIT TOP END!
GO UPDATE ]
CAMN ONE,(NODE) ;IS IT AN EMPTY NODE?
GO NLOOP ;NO, TRY NEXT
HRLZI 0,MINLINK(NODE) ;YES, COPY NODE INTO HOLE BELOW
HRRI 0,MINLINK(HOLE)
BLT 0,NODSIZ+MINLINK-1(HOLE)
HRRZM HOLE,(NODE) ;MAKE POINTER FROM OLD TO NEW LOCATION
SETOM INVALID
GO HLOOP
;Pass two: Go thru all of node space and check for pointers between
;BREAK and top of node space and change them to point to new
;location below BREAK.
PTYPE←HOLE
UPDATE: SKIPN INVALID
POPJ P,
LAC NODE,UNIVERS
ULOOP: LAC PTYPE,(NODE)
TLNE PTYPE,400400 ;FRAME CHEAT
SETZ PTYPE,
ANDI PTYPE,TYPMASK
HLLZ 0,REL(PTYPE)
CAIN PTYPE,$YNODE
HLLZ 0,YREL(NODE)
LSH 0,6
MOVEI P1,NODSIZ+MINLINK-1(NODE)
LLOOP: JUMPE 0,DORIGHT
JUMPL 0,[CAR 1,(P1)
CAMGE 1,BREAK
GO .+1
CAMLE 1,44
GO [ WARNING<INVALID POINTER FOUND>
GO .+1 ]
LAC 1,(1)
DIP 1,(P1)
GO .+1]
LSH 0,1
SOJA P1,LLOOP
DORIGH: HRLZ 0,REL(PTYPE)
CAIN PTYPE,$YNODE
HRLZ 0,YREL(NODE)
LSH 0,6
MOVEI P1,NODSIZ+MINLINK-1(NODE)
RLOOP: JUMPE 0,DONEXT
JUMPL 0,[CDR 1,(P1)
CAMGE 1,BREAK
GO .+1
CAMLE 1,44
GO [ WARNING<INVALID POINTER FOUND>
GO .+1 ]
LAC 1,(1)
DAP 1,(P1)
GO .+1]
LSH 0,1
SOJA P1,RLOOP
DONEXT: NXTNOD NODE,BREAK
GO .+2
GO ULOOP
;We're done, now shrink core size and make a new AVAIL list.
;(This may need to be rewritten for non-contiguous node space)
DONE: LAC HOLE,BREAK
MOVEI 0,MINLINK(HOLE)
CORE 0,
FATAL<Can't shrink core!>
HRRZI 1,MINLINK+1(HOLE)
CAMN 1,44 ;CHECK THE OBSCURE CASE
GO [ SETZB 0,2 ;YES, RIGHT ON THE CORE BOUNDARY
GO NOFREE ] ;MKNODE WILL GET MORE WHEN IT NEEDS IT
HRLI 1,MINLINK(HOLE) ;ZERO FREE AREA
SETZM MINLINK(HOLE)
LAC 2,44 ;LEAVE TOP IN 2 FOR FAST COMPARES
BLT 1,(2)
SETZ 0,
; SUBI HOLE,NODSIZ
MKLOOP: CAIGE 2,NODSIZ+MINLINK-1(HOLE) ;IS IT IN CORE?
GO AVLFIN
DAC ONE,(HOLE) ;SET TYPE BITS
HRRZM 0,MINLINK(HOLE) ;LINK TO PREVIOUS FREE NODE
MOVEI 0,MINLINK(HOLE) ;THIS FREE NODE
ADDI HOLE,NODSIZ
GO MKLOOP
AVLFIN: SUBI 2,MINLINK(HOLE) ;AMOUNT OF SPACE LEFT
NOFREE: DAC 2,REMAINDER
DAC 0,@AVAIL
SETZM INVALID
LAC 1,BREAK
SUB 1,UNIVERSE
POPJ P,
DECLARE{BREAK}
ENDR COMPACT;2-MAY-73(TVR)
SUBR RELOCATE,OFFSET
DEFINE NXTNOD(AC,LIMIT)
< ADDI AC,NODSIZ
CAML AC,LIMIT
>
ACCUMULATORS{P1,NODE,HOLE,LOWER,UPPER,DELTA}
PTYPE←←HOLE
LAC UPPER,@BLKCNT ;CALCULATE ADDRESS OF BREAK
IMULI UPPER,NODSIZ
LAC NODE,UNIVERS
MOVEI LOWER,MINLINK(NODE)
LAC DELTA,OFFSET↔SUB LOWER,DELTA
LAC UPPER,44↔SUB UPPER,DELTA
ULOOP: LAC PTYPE,(NODE)
TLNE PTYPE,400400↔ZAC PTYPE, ;FRAME CHEAT
ANDI PTYPE,TYPMASK
HLLZ 0,REL(PTYPE)
CAIN PTYPE,$YNODE
HLLZ 0,YREL(NODE)
LSH 0,6
LACI P1,NODSIZ+MINLINK-1(NODE)
LLOOP: JUMPE 0,DORIGHT
JUMPL 0,[CAR 1,(P1)
CAML 1,LOWER
CAML 1,UPPER
GO .+1
ADD 1,DELTA
DIP 1,(P1)
GO .+1]
LSH 0,1
SOJA P1,LLOOP
DORIGH: HRLZ 0,REL(PTYPE)
CAIN PTYPE,$YNODE
HRLZ 0,YREL(NODE)
LSH 0,6
MOVEI P1,NODSIZ+MINLINK-1(NODE)
RLOOP: JUMPE 0,DONEXT
JUMPL 0,[CDR 1,(P1)
CAML 1,LOWER
CAML 1,UPPER
GO .+1
ADD 1,DELTA
DAP 1,(P1)
GO .+1]
LSH 0,1
SOJA P1,RLOOP
DONEXT: NXTNOD NODE,44
GO [ SETZM INVALID↔POP1J ]
GO ULOOP
ENDR RELOCATE;5/2/73(TVR)--------------------------------------------
END
MEM.FAI - EOF.